
{***********************************************************}
{                                                           }
{      Informix Data Access Components                      }
{                                                           }
{      Informix Field Types Mapping                         }
{                                                           }
{      Copyright (c) 2001-2008 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit IfxFieldTypes;

{$I lx.inc}

interface

uses
  Classes, DB, IfxTypes, IfxSqlTypes;


type

{ TIfxFieldTypes }

  TIfxFieldTypesArray = array [0..SQLMAXTYPES - 1] of TFieldType;

  TIfxFieldTypes = class(TComponent)
  private
    FNativeCharacter: Boolean;
    FNativeNumeric: Boolean;
    FNativeTime: Boolean;
    FNativeSmartLob: Boolean;
    FTypesArray: TIfxFieldTypesArray;
    FDateTimeFull: TFieldType;
    FDateTimeOnlyDate: TFieldType;
    FDateTimeOnlyTime: TFieldType;
    FClob: TFieldType;
    FBlob: TFieldType;
    FOpaque: TFieldType;
    function GetItem(Index: Integer): TFieldType;
    procedure SetItem(Index: Integer; Value: TFieldType);
  protected
    procedure Loaded; override;
  public
    class function DefaultTypes: TIfxFieldTypes;
    class function GetTypeName(sqltype: int2; sqlxid: int4): string; overload;
    class function GetTypeName(FieldDef: TFieldDef): string; overload;
    class function IsStringType(sqltype: int2; sqlxid: int4): Boolean;
    class function IsOpaqueType(sqltype: int2; sqlxid: int4): Boolean;
    class function IsBlobType(sqltype: int2; sqlxid: int4): Boolean;
    constructor Create(AOwner: TComponent); override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    function GetMapping(sqltype: int2; sqllen: int4; sqlxid: int4): TFieldType;
    procedure InitFieldDef(FieldDef: TFieldDef; FieldNo: Integer;
      const FieldName: string; sqltype: int2; sqllen: int4; sqlxid: int4);
    property TypeList: TFieldType index SQLLIST read GetItem;
    property TypeMultiSet: TFieldType index SQLMULTISET read GetItem;
    property TypeRow: TFieldType index SQLROW read GetItem;
    property TypeSet: TFieldType index SQLSET read GetItem;
  published
    property NativeCharacter: Boolean read FNativeCharacter write FNativeCharacter default False;
    property NativeNumeric: Boolean read FNativeNumeric write FNativeNumeric default False;
    property NativeTime: Boolean read FNativeTime write FNativeTime default False;
    property NativeSmartLob: Boolean read FNativeSmartLob write FNativeSmartLob default False;
    property TypeBlob: TFieldType read FBlob write FBlob default ftOraBlob;
    property TypeBoolean: TFieldType index SQLBOOL read GetItem write SetItem default ftBoolean;
    property TypeByte: TFieldType index SQLBYTES read GetItem write SetItem default ftBlob;
    property TypeChar: TFieldType index SQLCHAR read GetItem write SetItem default ftFixedChar;
    property TypeClob: TFieldType read FClob write FClob default ftOraClob;
    property TypeDate: TFieldType index SQLDATE read GetItem write SetItem default ftDate;
    property TypeDateTimeFull: TFieldType read FDateTimeFull write FDateTimeFull default ftDateTime;
    property TypeDateTimeOnlyDate: TFieldType read FDateTimeOnlyDate write FDateTimeOnlyDate default ftDateTime;
    property TypeDateTimeOnlyTime: TFieldType read FDateTimeOnlyTime write FDateTimeOnlyTime default ftDateTime;
    property TypeDecimal: TFieldType index SQLDECIMAL read GetItem write SetItem default ftFloat;
    property TypeFloat: TFieldType index SQLFLOAT read GetItem write SetItem default ftFloat;
    property TypeInt: TFieldType index SQLINT read GetItem write SetItem default ftInteger;
    property TypeInt8: TFieldType index SQLINT8 read GetItem write SetItem default ftLargeint;
    property TypeInterval: TFieldType index SQLINTERVAL read GetItem write SetItem default ftString;
    property TypeLVarChar: TFieldType index SQLLVARCHAR read GetItem write SetItem default ftString;
    property TypeMoney: TFieldType index SQLMONEY read GetItem write SetItem default ftCurrency;
    property TypeNChar: TFieldType index SQLNCHAR read GetItem write SetItem default ftFixedChar;
    property TypeNVarChar: TFieldType index SQLNVCHAR read GetItem write SetItem default ftString;
    property TypeOpaque: TFieldType read FOpaque write FOpaque default ftTypedBinary;
    property TypeSerial: TFieldType index SQLSERIAL read GetItem write SetItem default ftInteger;
    property TypeSerial8: TFieldType index SQLSERIAL8 read GetItem write SetItem default ftLargeint;
    property TypeSmallFloat: TFieldType index SQLSMFLOAT read GetItem write SetItem default ftFloat;
    property TypeSmallInt: TFieldType index SQLSMINT read GetItem write SetItem default ftSmallint;
    property TypeText: TFieldType index SQLTEXT read GetItem write SetItem default ftMemo;
    property TypeVarChar: TFieldType index SQLVCHAR read GetItem write SetItem default ftString;
  end;


implementation

uses SysUtils, IfxDecimal, IfxDateTime, IfxConsts, Ifx, IfxIntf;


{ TIfxFieldTypes }

const
  IFX_DEFAULT_FIELDS_MAPPING: TIfxFieldTypesArray =
  (
    ftFixedChar,                        // SQLCHAR
    ftSmallint,                         // SQLSMINT
    ftInteger,                          // SQLINT
    ftFloat,                            // SQLFLOAT
    ftFloat,                            // SQLSMFLOAT
    ftFloat,                            // SQLDECIMAL
    ftInteger,                          // SQLSERIAL
    ftDate,                             // SQLDATE
    ftCurrency,                         // SQLMONEY
    ftUnknown,                          // SQLNULL
    ftDateTime,                         // SQLDTIME
    ftBlob,                             // SQLBYTES
    ftMemo,                             // SQLTEXT
    ftString,                           // SQLVCHAR
    ftString,                           // SQLINTERVAL
    ftFixedChar,                        // SQLNCHAR
    ftString,                           // SQLNVCHAR
    ftLargeint,                         // SQLINT8
    ftLargeint,                         // SQLSERIAL8
    ftTypedBinary,                      // SQLSET
    ftTypedBinary,                      // SQLMULTISET
    ftTypedBinary,                      // SQLLIST
    ftTypedBinary,                      // SQLROW
    ftTypedBinary,                      // SQLCOLLECTION
    ftUnknown,                          // SQLROWREF
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftUnknown,                          // reserved
    ftTypedBinary,                      // SQLUDTVAR
    ftTypedBinary,                      // SQLUDTFIXED
    ftUnknown,                          // SQLREFSER8
    ftString,                           // SQLLVARCHAR
    ftUnknown,                          // SQLSENDTSV
    ftBoolean,                          // SQLBOOL
    ftUnknown,                          // SQLIMPEXP
    ftUnknown,                          // SQLIMPEXPBIN
    ftUnknown                           // SQLUDRDEFAULT
  );


  FIELD_TYPE_TO_IFX_TYPE: array [TFieldType] of int2 =
  (
    -1,                                 // ftUnknown
    SQLVCHAR,                           // ftString
    SQLSMINT,                           // ftSmallint
    SQLINT,                             // ftInteger
    SQLSMINT,                           // ftWord
    SQLSMINT,                           // ftBoolean
    SQLFLOAT,                           // ftFloat
    SQLMONEY,                           // ftCurrency
    SQLDECIMAL,                         // ftBCD
    SQLDATE,                            // ftDate
    SQLDTIME,                           // ftTime
    SQLDTIME,                           // ftDateTime
    -1,                                 // ftBytes
    -1,                                 // ftVarBytes
    SQLSERIAL,                          // ftAutoInc
    SQLBYTES,                           // ftBlob
    SQLTEXT,                            // ftMemo
    SQLBYTES,                           // ftGraphic
    SQLTEXT,                            // ftFmtMemo
    -1,                                 // ftParadoxOle
    -1,                                 // ftDBaseOle
    CLVCHARPTRTYPE,                     // ftTypedBinary
    -1,                                 // ftCursor
    SQLCHAR,                            // ftFixedChar
    SQLNVCHAR,                          // ftWideString
    SQLINT8,                            // ftLargeint
    -1,                                 // ftADT
    -1,                                 // ftArray
    -1,                                 // ftReference
    -1,                                 // ftDataSet
    -1,                                 // ftOraBlob
    -1,                                 // ftOraClob
    -1,                                 // ftVariant
    -1,                                 // ftInterface
    -1,                                 // ftIDispatch
    -1                                  // ftGuid
{$IFDEF D6},
    SQLDTIME,                           // ftTimeStamp,
    SQLDECIMAL                          // ftFMTBcd
{$ENDIF}
{$IFDEF D10},
    SQLNCHAR,                           // ftFixedWideChar
    SQLTEXT,                            // ftWideMemo
    SQLDTIME,                           // ftOraTimeStamp
    SQLINTERVAL                         // ftOraIntervals
{$ENDIF}
    , SQLVCHAR
    , SQLVCHAR
    , SQLVCHAR
    , SQLVCHAR
    , SQLVCHAR
    , SQLVCHAR
    , SQLVCHAR
    );

var
  globalDefaultTypes: TIfxFieldTypes;

class function TIfxFieldTypes.DefaultTypes: TIfxFieldTypes;
begin
  Result := globalDefaultTypes;
end;

class function TIfxFieldTypes.GetTypeName(sqltype: int2; sqlxid: int4): string;
begin
  case sqlxid of
    XID_LVARCHAR: Result := 'lvarchar';
    XID_BOOLEAN:  Result := 'boolean';
    XID_BLOB:     Result := 'blob';
    XID_CLOB:     Result := 'clob';
    else          Result := rtypname(sqltype)
  end;
end;

class function TIfxFieldTypes.GetTypeName(FieldDef: TFieldDef): string;
var
  sqltype: int2;
begin
  with FieldDef do
  begin
    case DataType of
      ftBoolean: Result := 'boolean';
      ftTime: Result := 'datetime hour to fraction(3)';
      ftDateTime: Result := 'datetime year to fraction(3)';
      ftOraBlob: Result := 'blob';
      ftOraClob: Result := 'clob';
      else
        sqltype := FIELD_TYPE_TO_IFX_TYPE[DataType];
        if sqltype < 0 then
          IDACErrorFmt(SUnsupportedFieldType, [FieldTypeNames[DataType], Name]);
        Result := rtypname(sqltype);
        if sqltype in [SQLDECIMAL, SQLMONEY] then
          Result := Result + Format('(%d, %d)', [Precision, Size])
        else if IsStringType(sqltype, 0) then
          Result := Result + Format('(%d)', [Size]);
    end;
    if faRequired in Attributes then
      Result := Result + ' NOT NULL';
  end;
end;

constructor TIfxFieldTypes.Create(AOwner: TComponent);
begin
  inherited;
  FTypesArray := IFX_DEFAULT_FIELDS_MAPPING;
  FDateTimeFull := ftDateTime;
  FDateTimeOnlyDate := ftDateTime;
  FDateTimeOnlyTime := ftDateTime;
  FClob := ftOraClob;
  FBlob := ftOraBlob;
  FOpaque := ftTypedBinary;
end;

procedure TIfxFieldTypes.AfterConstruction;
begin
  inherited;
  TIDACEvents.HandleObjectCreate(Self);
end;

procedure TIfxFieldTypes.BeforeDestruction;
begin
  TIDACEvents.HandleObjectDestroy(Self);
  inherited;
end;

function TIfxFieldTypes.GetItem(Index: Integer): TFieldType;
begin
  Result := FTypesArray[Index];
end;

procedure TIfxFieldTypes.SetItem(Index: Integer; Value: TFieldType);
begin
  FTypesArray[Index] := Value;
end;

procedure TIfxFieldTypes.Loaded;
begin
  inherited;
  TIDACEvents.HandleObjectLoaded(Self);
end;

function TIfxFieldTypes.GetMapping(sqltype: int2; sqllen: int4; sqlxid: int4): TFieldType;
begin
  sqltype := MASKNONULL(sqltype);

  if (sqltype < 0) or (sqltype >= SQLMAXTYPES) then
    if sqltype = CLVCHARPTRTYPE then
      Result := FOpaque else
      Result := ftUnknown

  else if sqltype = SQLDTIME then
    if TU_START(sqllen) > TU_DAY then
      Result := FDateTimeOnlyTime
    else if TU_END(sqllen) < TU_HOUR then
      Result := FDateTimeOnlyDate
    else
      Result := FDateTimeFull

  else
    case sqlxid of
      XID_LVARCHAR:  Result := TypeLVarChar;
      XID_BOOLEAN:   Result := TypeBoolean;
      XID_BLOB:      Result := FBlob;
      XID_CLOB:      Result := FClob;
      else           Result := FTypesArray[sqltype];
    end;
end;

class function TIfxFieldTypes.IsStringType(sqltype: int2; sqlxid: int4): Boolean;
begin
  Result := (MASKNONULL(sqltype) in [SQLCHAR, SQLVCHAR, SQLNCHAR, SQLNVCHAR,
    SQLLVARCHAR]) or (sqlxid = XID_LVARCHAR);
end;

class function TIfxFieldTypes.IsOpaqueType(sqltype: int2; sqlxid: int4): Boolean;
begin
  Result := (MASKNONULL(sqltype) in [SQLSET, SQLMULTISET, SQLLIST, SQLROW,
    SQLCOLLECTION, SQLROWREF, SQLUDTVAR, SQLUDTFIXED]) and not (sqlxid in
    [XID_BOOLEAN, XID_BLOB, XID_CLOB]);
end;

class function TIfxFieldTypes.IsBlobType(sqltype: int2; sqlxid: int4): Boolean;
begin
  Result := (MASKNONULL(sqltype) in [SQLBYTES, SQLTEXT]) or
    (sqlxid in [XID_BLOB, XID_CLOB]);
end;

procedure TIfxFieldTypes.InitFieldDef(FieldDef: TFieldDef; FieldNo: Integer;
  const FieldName: string; sqltype: int2; sqllen: int4; sqlxid: int4);
var
  I: Integer;
  FieldDefName: string;
begin
  FieldDef.FieldNo := FieldNo;

  I := 0;
  FieldDefName := FieldName;
  while TDefCollection(FieldDef.Collection).Find(FieldDefName) <> nil do
  begin
    Inc(I);
    FieldDefName := Format('%s_%d', [FieldName, I]);
  end;
  FieldDef.Name := FieldDefName;

  FieldDef.DataType := GetMapping(sqltype, sqllen, sqlxid);

  case FieldDef.DataType of
    ftString, ftFixedChar, ftWideString:
      if MASKNONULL(sqltype) = SQLINTERVAL then
        FieldDef.Size := 25
      else if not IsStringType(sqltype, sqlxid) then
        FieldDef.Size := 0
      else
      begin
{$IFNDEF D6}
        if not FNativeCharacter and (sqllen > dsMaxStringSize) then
          FieldDef.DataType := ftMemo;
{$ENDIF}
        FieldDef.Size := sqllen;
      end;
    ftBCD{$IFDEF D6}, ftFMTBcd{$ENDIF}:
      if not (MASKNONULL(sqltype) in [SQLDECIMAL, SQLMONEY]) then
        FieldDef.Size := 0
      else
        if FNativeNumeric then
          FieldDef.Size := sqllen
        else if PRECDEC(sqllen) < $FF then
        begin
          FieldDef.Precision := PRECTOT(sqllen);
          FieldDef.Size := PRECDEC(sqllen);
        end else
        begin
          FieldDef.Precision := 64;
          FieldDef.Size := 32;
        end;
    ftCurrency:
      if (MASKNONULL(sqltype) in [SQLDECIMAL, SQLMONEY]) and FNativeNumeric then
        FieldDef.Size := sqllen else
        FieldDef.Size := 0;
    ftDateTime{$IFDEF D6}, ftTimeStamp{$ENDIF}:
      if (MASKNONULL(sqltype) = SQLDTIME) and FNativeTime then
        FieldDef.Size := sqllen;
    else
      FieldDef.Size := 0;
  end;

  FieldDef.Required := (sqltype and SQLNONULL <> 0) and not ISSERIALTYPE(sqltype);
end;


initialization
  globalDefaultTypes := TIfxFieldTypes.Create(nil);

finalization
  FreeAndNil(globalDefaultTypes);

end.